home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / tiptrix / Dbrestr / DBRestr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-05-05  |  3.9 KB  |  129 lines
  1. unit DBRestr;
  2. (* April 1997, Author : Roberto De Marini,
  3.      e-mail : rdemari@poboxes.com *)
  4. interface
  5.  
  6. uses
  7.   DB,DBTables,{$IFDEF Win32} Bde {$ELSE} DbiTypes,DbiProcs {$ENDIF};
  8.  
  9. type
  10.   TResOp = (resADD,resDROP,resMODIFY,resMOVE);
  11.  
  12.   procedure Restructure(ATable:TTable; OpType: TResOp; FNum, FDest: integer;
  13.     FName: string; FType: TFieldType; FSize: word);
  14.  
  15.  
  16.  
  17. implementation
  18.  
  19. uses
  20.   SysUtils,{$IFDEF Win32}DBRUtl32 {$ELSE}DBRUtl16 {$ENDIF};
  21.  
  22.  
  23. procedure Restructure(ATable:TTable; OpType: TResOP; FNum,FDest: integer;
  24.   FName: string; FType: TFieldType; FSize: word);
  25. type
  26.   TFldArr = array[1..1000] of FldDesc;
  27.   TOpArr = array[1..1000] of CROpType;
  28. var
  29.   hDb: hDbiDb;
  30.   TblDesc: CRTblDesc;
  31.   Dir:array[0..255] of char;
  32.   pFldArr : ^TFldArr;
  33.   pOpArr : ^TOpArr;
  34.   FldCount,NewCount,j : integer;
  35.   SaveActive: boolean;
  36.   FDesc: FldDesc;
  37.   Props: CURPROPS;
  38.   TableTypeName : PChar;
  39. begin
  40.   with ATable do begin
  41.     if Database.IsSqlBased then
  42.       raise Exception.Create('Cannot restructure SQL tables');
  43.     SaveActive:=Active;
  44.     if not Active then Active := true;
  45.   end;
  46.   TableTypeName := GetTableTypeName(ATable);
  47.   Check(DbiGetDirectory(ATable.DBHandle, False, Dir));
  48.   Check(DbiGetCursorProps(ATable.Handle, Props));
  49.   FldCount := Props.iFields;
  50.   if OpType = resAdd then NewCount:=FldCount+1
  51.   else NewCount := FldCount;
  52.   if NewCount =0 then exit;
  53.   pFldArr := AllocMem(NewCount * SizeOf(FLDDesc));
  54.   pOpArr := AllocMem(NewCount * SizeOf(CROpType));
  55.   Check(DbiGetFieldDescs(ATable.Handle, @pfldArr^[1]));
  56.   try
  57.     FillChar(TblDesc, sizeof(CRTblDesc), #0);
  58.     TblDesc.bPack := True;
  59.     case OpType of
  60.       resModify : begin
  61.         TblDesc.iFldCount := FldCount;
  62.         with pFldArr^[FNum+1] do
  63.           AnsiToNative(ATable.Locale, FName, szName, SizeOf(szName) - 1);
  64.           pOpArr^[FNum+1]:=crModify;
  65.         for j:=1 to TblDesc.iFldCount do
  66.           pFldArr^[j].iFldNum := j;
  67.       end;
  68.  
  69.       resAdd: begin
  70.         TblDesc.iFldCount := FldCount+1;
  71.         if FNum < FldCount then
  72.           System.Move(pFldArr^[FNum+1],pFldArr^[FNum+2],
  73.             (FldCount-FNum)*Sizeof(FldDesc));
  74.         MapField(ATable,pFldArr^[FNum+1],FName,FType,FSize);
  75.         pOpArr^[FNum+1]:=crAdd;
  76.         for j:=1 to FNum do
  77.           pFldArr^[j].iFldNum := j;
  78.         if FNum < FldCount then
  79.         for j:=FNum+2 to FldCount+1 do
  80.           pFldArr^[j].iFldNum := j-1;
  81.       end;
  82.  
  83.       resDrop: begin
  84.         TblDesc.iFldCount := FldCount-1;
  85.         if FNum < FldCount-1 then
  86.           System.Move(pFldArr^[FNum+2],pFldArr^[FNum+1],
  87.             (FldCount-FNum-1)*Sizeof(FldDesc));
  88.         for j:=1 to FNum do
  89.           pFldArr^[j].iFldNum := j;
  90.         for j:=FNum+1 to FldCount-1 do
  91.           pFldArr^[j].iFldNum := j+1;
  92.       end;
  93.  
  94.       resMove: begin
  95.         TblDesc.iFldCount := FldCount;
  96.         for j:=1 to TblDesc.iFldCount do
  97.           pFldArr^[j].iFldNum := j;
  98.         FDesc := pFldArr^[FNum+1];
  99.         if FDest > FNum then
  100.           System.Move(pFldArr^[FNum+2],pFldArr^[FNum+1],
  101.             (FDest-FNum)*Sizeof(FldDesc))
  102.         else
  103.           System.Move(pFldArr^[FDest+1],pFldArr^[FDest+2],
  104.             (FNum-FDest)*Sizeof(FldDesc));
  105.         pFldArr^[FDest+1]:=FDesc;
  106.       end;
  107.     end;
  108.  
  109.     ATable.Close;
  110.     Check(DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb));
  111.     Check(DbiSetDirectory(hDb, Dir));
  112.     TblDesc.pFldDesc := @pFldArr^[1];
  113.     TblDesc.pecrFldOp := @pOpArr^[1];
  114.     if TableTypeName <> nil then
  115.       StrCopy(TblDesc.szTblType, TableTypeName);
  116.     StrPCopy(TblDesc.szTblName, ATable.TableName);
  117.     Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
  118.   finally
  119.     Check(DbiCloseDatabase(hDb));
  120.     FreeMem(pFldArr, NewCount * SizeOf(FLDDesc));
  121.     FreeMem(pOpArr, NewCount * SizeOf(CROpType));
  122.     if SaveActive then
  123.       ATable.Open;
  124.   end;
  125. end;
  126.  
  127.  
  128. end.
  129.